COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 test du compilateur 
C00003 00003	 test de generation speciales 
C00004 00004	 test de rapidite 
C00008 ENDMK
C⊗;
; test du compilateur ;

(OUTPUT 'TCMPIL)

⊃
(STATUS 1 0 1 2)
↓PRETTY
⊃
(STATUS 1 0 1 2)
↓LODLAP
⊃
(STATUS 1 0 1 2)
↓LAPACK
⊃
(STATUS 1 0 1 2)
↓COMPIL
⊃
(STATUS 1 0 1 2)

(DE fact (n) (IF (ZEROP n) 1 (TIMES n (fact (SUB1 n)))))
(fact 6)
(COMPILE fact T T T)
(fact 6)

(DE A (X Y) 
   (COND
      ((ZEROP X) (ADD1 Y))
      ((ZEROP Y) (A (SUB1 X) 1))
      (T (A (SUB1 X) (A X (SUB1 Y))))))
(A 3 3)
(COMPILE A T T T)
(A 3 3)

(DE DROP (U) ; cf Mc CARTHY ;
   (COND
	((NULL U) NIL)
	(T (CONS [(CAR U)] (DROP (CDR U)))))))))

(COMPILE DROP T T T)

(DROP '(A B C))
; test de generation speciales ;

(DE FOO1 (X)
	['SETQ X ['CDR X]])

(COMPILE FOO1 T T T)
(FOO1 'A)

(DE FOO2 (X Y) 
       [['SETQ X [X 'CDR]]
	[Y (CAR Y)]
	['CAR]
	[]])))
(COMPILE FOO2 T T T)
(FOO2 'A '(B C))

(DE FOO3 (X Y Z)
   (REPEAT (ABS (DIFFER (SUB1 X) Y)) (PRIN1 Z))
   (TERPRI))
(COMPILE FOO3 T T T)
(FOO3 10 5 'GLUCK)
; test de rapidite ;

(DE SORTL (L ;; S X)
    (SETQ S (APPEND L))
    (MAP S (LAMBDA (SL) (AND (CDR L)
	(MAP (CDR SL) (LAMBDA (SL1)
	(OR (SORT (CAR SL) (CAR SL1))
	    (PROGN (SET 'X (CAR SL) SL (CAR SL1))
		(RPLACA SL1 X)))))))) S ))) )))

(PROGN (SETQ LISTEST (NTH 550 (OBLIST))) (LENGTH LISTEST))
(PROGN (SORTL (APPEND LISTEST)) 'INTERPRETE)
(COMPILE SORTL T T T)
(PROGN (SORTL (APPEND LISTEST)) 'COMPILATEUR)

( LAP '(
  ;;;;;;
         (ENTRY %F2%F1SORTL SUBR 1)
;        (JSP L :SBIND1)	;
;        (XWD 0 'SL1)		;
(MOVEI U1 0 1) ; U1 = SL1 ;
         (GETVAL 1 SL)
         (CAR 1 1)
;        (GETVAL 2 SL1)		;
;        (CAR 2 2)		;
(CAR U1 2)
         (PUSHJ P SORT)
         (JUMPN 1 :VPOPJ)
         (PUSH P %T1)      ; (XWD -1 SET) ;
         (PUSH P %T2)      ; 'X ;
         (GETVAL 1 SL)
         (CAR 1 1)
         (PUSH P 1)
         (GETVAL 1 SL)
         (PUSH P 1)
;        (GETVAL 1 SL1)		;
;        (CAR 1 1)		;
(CAR U1 1)
         (JSP L :NSUBR)
;        (GETVAL 1 SL1)		;
(MOVEI 1 0 U1)
         (GETVAL 2 X)
         (RPLACA 1 2)
         (POPJ P)
  ;;;;;;
         (ENTRY %F1SORTL SUBR 1)
         (JSP L :SBIND1)
         (XWD 0 'SL)
         (GETVAL 1 L)
         (CDR 1 1)
         (JUMPE 1 :VPOPJ)
         (GETVAL 1 SL)
         (CDR 1 1)
         (MOVEI 2 '%F2%F1SORTL)
         (JRST 0 :$MAP1)
  ;;;;;;
         (ENTRY SORTL SUBR 3)
         (JSP L :SBIND3)
         (XWD 0 '(L S X))
         (GETVAL 1 L)
         (SETZ 2)
         (PUSHJ P APPEND)
         (PUTVAL 1 S)
         (MOVEI 2 '%F1SORTL)
         (PUSHJ P :$MAP1)
         (GETVAL 1 S)
         (POPJ P)
  
  ;---------- # T B L
   #TBL LENGTH = 2 ;

   %T1 (XWD -1 SET)
   %T2 'X
  

   ) NIL )
  
(PROGN (SORTL (APPEND LISTEST)) 'HAND-CODEE)

(DE sortl1 (l) ; trier la liste l de pnames ;
  (if l 
      (let ((x (nextl l)) (l (self l))) (cond
	((null l) [x])
	((sort x (car l)) (cons x l))
	(t (cons (nextl l) (self x l)))))))

(PROGN (SORTL (APPEND LISTEST)) 'AUTRE)

(COMPILE SORTL1 T T T)

(PROGN (SORTL (APPEND LISTEST)) 'AUTRE)

(OUTPUT)
(PRINT "Le resultat est sur (DSK (TCMPIL . LST))")